perm filename TESSEL.SAI[SAI,BGB] blob sn#100500 filedate 1974-05-08 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00005 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	BEGIN "TESSEL"
C00004 00003	SUBR PROJECT
C00005 00004	SUBR ROTATE (REAL DELITG AXIS)
C00006 00005	α MAIN EXECUTION
C00007 ENDMK
C⊗;
BEGIN "TESSEL"
	REQUIRE "ABBREV[SYS,BGB]" SOURCE_FILE;
	REQUIRE "DPYIII[SYS,BGB]" SOURCE_FILE;
	SAFE ITG ARRAY DPYBUF[0:600];

	REAL ARRAY W,X,Y,Z[1:16];
	REAL ARRAY XWC,YWC,ZWC[1:16];
	REAL ARRAY XPP,YPP,ZPP[1:16];
	ITG ARRAY PVT,NVT[1:32];	α EDGES;
	ITG V,E,I,J,K,L;
	REAL RDEL;

SUBR INIT;
BEGIN "INIT"
	V←0;
	RDEL ← π/8;
	FOR I←-1,1 DO	FOR J←-1,1 DO
	FOR K←-1,1 DO	FOR L←-1,1 DO
	⊂ V←V+1;W[V]←I; X[V]←J; Y[V]←K; Z[V]←L ⊃;

	FOR I←1 THRU 8 DO ⊂ NVT[I]←I;PVT[I]←I+8;⊃;
	E←8;
	FOR I←1 STEP 2 UNTIL 15 DO ⊂ E←E+1;NVT[E]←I;PVT[E]←I+1;⊃;
	FOR I←1 THRU  4 DO ⊂ E←E+1;NVT[E]←I;PVT[E]←I+4;⊃;
	FOR I←9 THRU 12 DO ⊂ E←E+1;NVT[E]←I;PVT[E]←I+4;⊃;
	FOR I←1,2,5,6,9,10,13,14 DO ⊂ E←E+1;NVT[E]←I;PVT[E]←I+2;⊃;
END "INIT";
SUBR PROJECT;
BEGIN "PROJECT"
	FOR I←1 THRU 16 DO
⊂	XWC[I] ← 20*X[I] / (W[I]+5);
	YWC[I] ← 20*Y[I] / (W[I]+5);
	ZWC[I] ← 20*Z[I] / (W[I]+5);
	XPP[I] ← 1000*XWC[I]/(ZWC[I]-20);
	YPP[I] ← 1000*YWC[I]/(ZWC[I]-20);
⊃;
END "PROJECT";

SUBR DPY;
BEGIN "DPY"
	DPYSET(DPYBUF);
	FOR E←1 THRU 32 DO
	⊂ AIVECT(XPP[PVT[E]],YPP[PVT[E]]);
	 AVECT(XPP[NVT[E]],YPP[NVT[E]]);⊃;
	DPYOUT(1);
END "DPY";
SUBR ROTATE (REAL DEL;ITG AXIS);
BEGIN "ROTATE"
	REAL C,S,XX,YY,TMP;
	C ← COS(DEL); S ← SIN(DEL);

	FOR I←1 THRU 16 DO
BEGIN
	XX ← CASE AXIS OF (Y[I],Z[I],X[I],W[I],W[I],W[I]);
	YY ← CASE AXIS OF (Z[I],X[I],Y[I],X[I],Y[I],Z[I]);
	TMP ← C*XX - S*YY;
	YY  ← C*YY + S*XX;
	XX ← TMP;
	CASE AXIS OF ⊂ Y[I]←XX;Z[I]←XX;X[I]←XX;W[I]←XX;W[I]←XX;W[I]←XX; ⊃;
	CASE AXIS OF ⊂ Z[I]←YY;X[I]←YY;Y[I]←YY;X[I]←YY;Y[I]←YY;Z[I]←YY; ⊃;
END;
END "ROTATE";

α MAIN EXECUTION;
	INIT;
WHILE TRUE DO
BEGIN "LISTEN"
	ITG Q,CHR;
	PROJECT;DPY;
	CHR ← INCHRW;
	IF (CHR LAND '400)≠0 THEN Q←3 ELSE Q←0;
	CHR ← CHR LAND '177;

	IF CHR=":" THEN ROTATE(RDEL,0+Q) ELSE
	IF CHR=")" THEN ROTATE(RDEL,1+Q) ELSE
	IF CHR="*" THEN ROTATE(RDEL,2+Q) ELSE
	IF CHR=";" THEN ROTATE(-RDEL,0+Q) ELSE
	IF CHR="(" THEN ROTATE(-RDEL,1+Q) ELSE
	IF CHR="-" THEN ROTATE(-RDEL,2+Q) ELSE

	IF CHR="/" THEN RDEL←RDEL/2 ELSE
	IF CHR="\" THEN RDEL←RDEL*2;

END "LISTEN";

END "TESSEL";